Data Cleaning
Elia Zanini
2025-04-30
#Importo il dataset, faccio una prima pulizia e tengo i dati dagli anni 2000, degli omicidi risolti
dataset_path <- "D:/DESKTOP/Desktop/statistical learning pr/unsupervised 2/database.csv"
df <- read.csv(dataset_path)
#elimino colonne inutili
df$Record.ID <- NULL
df$Agency.Code <- NULL
df$Agency.Name <- NULL
df$Agency.Type <- NULL
df$City <- NULL
df$Victim.Ethnicity<- NULL
df$Perpetrator.Ethnicity<- NULL
df$Victim.Count<- NULL
df$Perpetrator.Count<- NULL
df$Record.Source<- NULL
df$Incident<- NULL
df$State <- NULL
df <- na.omit(df) #elimino righe con null values (df molto grande)
df <- df[!apply(df, 1, function(row) any(grepl("Unknown", row, ignore.case = TRUE))), ]
df <- df[df$Victim.Age <= 99 & df$Perpetrator.Age <= 99, ] #alcune età sono numeri inverosimili, limito a 99 anni
df <- df %>% filter(Perpetrator.Age >= 10) #tolgo casi con assassino <10 anni (involontari o falsi)df <- df %>%
filter(Year >= 1990)
df <- df %>%
filter(Crime.Solved == "Yes")
df$Crime.Solved <- NULL
df$Month <- NULL
df$Year <- NULLverifico e salvo
str(df)## 'data.frame': 102724 obs. of 9 variables:
## $ Crime.Type : chr "Murder or Manslaughter" "Manslaughter by Negligence" "Manslaughter by Negligence" "Murder or Manslaughter" ...
## $ Victim.Sex : chr "Female" "Male" "Male" "Male" ...
## $ Victim.Age : int 25 1 0 32 30 2 21 33 3 3 ...
## $ Victim.Race : chr "Black" "Asian/Pacific Islander" "Asian/Pacific Islander" "White" ...
## $ Perpetrator.Sex : chr "Male" "Male" "Female" "Male" ...
## $ Perpetrator.Age : int 28 12 39 39 20 20 21 20 19 23 ...
## $ Perpetrator.Race: chr "Black" "Asian/Pacific Islander" "Asian/Pacific Islander" "White" ...
## $ Relationship : chr "Wife" "Family" "Acquaintance" "Stranger" ...
## $ Weapon : chr "Handgun" "Blunt Object" "Blunt Object" "Rifle" ...
## - attr(*, "na.action")= 'omit' Named int 232235
## ..- attr(*, "names")= chr "232235"output_path <- "D:/DESKTOP/Desktop/statistical learning pr/unsupervised 2/dfsolved.csv"
write.csv(df, output_path, row.names = FALSE)#EXPLORATORY DATA A ##studio qualche dato interessante per comprendere il dataset, partendo dalla distribuzione delle età killer/vittime
par(mfrow = c(1, 2))
#Victim age
qqnorm(df$Victim.Age, main = "QQ Plot - Victim Age", col = "steelblue")
qqline(df$Victim.Age, col = "red")
#perpetrator age
qqnorm(df$Perpetrator.Age, main = "QQ Plot - Perpetrator Age", col = "darkgreen")
qqline(df$Perpetrator.Age, col = "red")
par(mfrow = c(1, 1)) #resetto##creo nuova colonna che mostra rapporto tra vittima e killer, per vedere distribuzioni omicidi su sesso
df$Combinazione <- paste(df$Perpetrator.Sex, "/", df$Victim.Sex)
tabella_sex <- df %>%
count(Combinazione) %>%
arrange(desc(n)) %>%
mutate(Percentuale = round(n / sum(n) * 100, 1))
colnames(tabella_sex)[1] <- "Perpetrator / Victim SEX"
colnames(tabella_sex)[2] <- "n tot"
colnames(tabella_sex)[3] <- "% of total"
tabella_sex## Perpetrator / Victim SEX n tot % of total
## 1 Male / Male 64471 62.8
## 2 Male / Female 27512 26.8
## 3 Female / Male 8063 7.8
## 4 Female / Female 2678 2.6ggplot(tabella_sex, aes(x = "", y = `% of total`, fill = `Perpetrator / Victim SEX`)) +
geom_col(width = 1, color = "white") +
coord_polar(theta = "y") +
theme_void() +
labs(title ="Distribution of kills by sex", fill ="Combination") +
geom_text(aes(label =paste0(`% of total`, "%")),
position = position_stack(vjust= 0.5),
color = "white", size =4)
df$Combinazione<-NULL#qua creo una funzione per raggruppare le principali relazioni tra killer e vittima
classifica_relazione <- function(x) {
x <- tolower(x)
if (x %in% c("husband", "wife", "ex-husband", "ex-wife", "boyfriend", "girlfriend", "boyfriend/girlfriend", "common-law husband", "common-law wife")) {return("Partner/Ex Partner")}
else if (x %in% c("family", "father", "mother", "daughter", "son", "sister", "brother", "stepfather", "stepmother", "stepdaughter", "stepson", "in-law")) {return("Family")}
else if (x == "friend") {return("Friend")}
else if (x == "acquaintance") { return("Acquaintance")}
else if (x == "stranger") {return("Stranger")}
else {return("Other")}}
df$Relazione_Semplificata <- sapply(df$Relationship, classifica_relazione) #applico sul df
#sno interessato a trovare la statistica diversa per maschi e femmine dunque divido i dati per sesso
maschi <- df[df$Perpetrator.Sex == "Male", ]
femmine <- df[df$Perpetrator.Sex == "Female", ]
#funzione per creare tabella e tenere solo le prime 5 categorie
pie_data <- function(dati) {
tab <- as.data.frame(table(dati$Relazione_Semplificata))
colnames(tab)<- c("Relazione", "Frequenza")
tab <-tab[order(-tab$Frequenza), ]
tab <- head(tab, 5)
tab$Percentuale <- round(tab$Frequenza /sum(tab$Frequenza)* 100, 1)
return(tab)}
rel_maschi <- pie_data(maschi)
rel_femmine <- pie_data(femmine)
#torta maschi
ggplot(rel_maschi, aes(x = "", y = Percentuale, fill = Relazione)) +
geom_col(width = 1, color = "white") +
coord_polar("y") +
theme_void() +
labs(title = "Male- relationship with victim (top 5)") +
geom_text(aes(label = paste0(Percentuale, "%")),
position = position_stack(vjust = 0.5), color = "white", size = 4)
#torta femmine
ggplot(rel_femmine, aes(x = "", y = Percentuale, fill = Relazione)) +
geom_col(width = 1, color = "white") +
coord_polar("y") +
theme_void() +
labs(title = "Female - Relationship with victim (top 5)") +
geom_text(aes(label = paste0(Percentuale, "%")),
position = position_stack(vjust = 0.5), color = "white", size = 4)
df$Relazione_Semplificata<-NULL#VARIABLES TRASFORMATIONS inizio a trasformare le variabili categoriche in numeriche per PCA e clustering
##parto dalle piu semplici (dummy)
#volontario =1, non volontario =0
df$Crime.Type <-ifelse(grepl("Murder", df$Crime.Type), 1, 0)
#Victim.Sex (0 = male, 1 = fem)
df$Victim.Sex <-ifelse(df$Victim.Sex == "Female", 1, 0)
#Perpetrator.Sex (0 = maschio, 1 = femm)
df$Perpetrator.Sex <-ifelse(df$Perpetrator.Sex== "Female", 1, 0)
#Weapon (Arma da fuoco = 1, resto = 0)
df$Weapon <-ifelse(grepl("Handgun|Shotgun|Rifle|Firearm", df$Weapon),1, 0)##variabile Relationship divido i casi di omicidi tra relazioni con la vittima “strette” (0) e non (1)
table(df$Relationship)##
## Acquaintance Boyfriend Boyfriend/Girlfriend
## 31827 2226 344
## Brother Common-Law Husband Common-Law Wife
## 1478 218 566
## Daughter Employee Employer
## 2396 104 154
## Ex-Husband Ex-Wife Family
## 125 624 3410
## Father Friend Girlfriend
## 1492 5515 6526
## Husband In-Law Mother
## 1649 856 1625
## Neighbor Sister Son
## 1644 380 3119
## Stepdaughter Stepfather Stepmother
## 280 398 61
## Stepson Stranger Wife
## 394 27460 7853contatti_non_stretti <- c("Stranger", "Acquaintance", "Employee", "Employer")
#Dummy: 1 = NON contatto stretto, 0 = contatto stretto
df$Rel_NotClose <- ifelse(df$Relationship %in% contatti_non_stretti, 1, 0)
table(df$Rel_NotClose)##
## 0 1
## 43179 59545df$Relationship<-NULL##variabile “race” semplifico le due colonne di variabili in un unica dummy casi in cui killer e vittima hanno la stessa etnia (1), e casi in cui è diversa(0)
df$Victim.Race <- tolower(df$Victim.Race)
df$Perpetrator.Race <-tolower(df$Perpetrator.Race)
df$Same_Race<- ifelse(df$Victim.Race == df$Perpetrator.Race, 1, 0)
df$Victim.Race <- NULL
df$Perpetrator.Race <- NULL##check finale
str(df)## 'data.frame': 102724 obs. of 8 variables:
## $ Crime.Type : num 1 0 0 1 1 1 1 1 0 0 ...
## $ Victim.Sex : num 1 0 0 0 0 0 0 1 0 0 ...
## $ Victim.Age : int 25 1 0 32 30 2 21 33 3 3 ...
## $ Perpetrator.Sex: num 0 0 1 0 0 0 0 0 0 1 ...
## $ Perpetrator.Age: int 28 12 39 39 20 20 21 20 19 23 ...
## $ Weapon : num 1 0 0 1 1 0 1 0 0 0 ...
## $ Rel_NotClose : num 0 0 1 1 1 1 1 1 1 0 ...
## $ Same_Race : num 1 1 1 1 1 1 0 0 0 1 ...
## - attr(*, "na.action")= 'omit' Named int 232235
## ..- attr(*, "names")= chr "232235"#PCA
df_scaled <-scale(df) #scalo tutte le variabili standardizzandole
pca_result<- prcomp(df_scaled, center = TRUE, scale. = TRUE)
#Scree plot: percentuale di varianza spiegata da ciascun componente
pca_var <- pca_result$sdev^2
pca_var_perc <-round(pca_var / sum(pca_var) * 100, 1)
barplot(pca_var_perc,
main = "Scree Plot - PCA",
xlab ="Principal Component",
ylab = "Percentuale di varianza spiegata",
names.arg = paste0("PC", 1:length(pca_var_perc)),
col = "lightblue")
#creo dataset con le principal components
pca_df <-as.data.frame(pca_result$x)
pca_df$Cluster <- NA # inizialmente nessun cluster assegnato
#loadings sono le direzioni delle variabili originali
loadings<- as.data.frame(pca_result$rotation[, 1:2])
loadings$Variable <- rownames(loadings)
#Visualizzazione PCA con frecce
library(ggplot2)
library(grid) # per freccia
ggplot(pca_df, aes(x =PC1, y= PC2)) +
geom_point(alpha = 0.4, color = "steelblue") +
geom_segment(data=loadings, aes(x = 0, y = 0, xend = PC1* 5, yend=PC2 * 5), arrow = arrow(length=unit(0.2, "cm")), color= "darkred", size = 0.8) +
geom_text(data = loadings,
aes(x =PC1 * 5.5, y =PC2 * 5.5, label = Variable),
color ="darkred", size= 4) +
theme_minimal() +
labs(title = "Biplot PCA con frecce (loadings)",
x = paste0("PC1 (",pca_var_perc[1],"%)"),
y = paste0("PC2 (", pca_var_perc[2], "%)"))
round(pca_result$rotation[,1:2], 2)## PC1 PC2
## Crime.Type 0.00 -0.39
## Victim.Sex -0.47 0.04
## Victim.Age -0.34 -0.53
## Perpetrator.Sex -0.20 0.43
## Perpetrator.Age -0.48 -0.40
## Weapon 0.27 -0.33
## Rel_NotClose 0.54 -0.27
## Same_Race -0.19 0.19#ELBOW PLOT per capire quanti n clusters usare
wss <- numeric(10)
for (k in 1:10) {
kmeans_result<- kmeans(pca_df[, 1:2], centers= k, nstart = 25)
wss[k] <-kmeans_result$tot.withinss
}
plot(1:10, wss, type = "b", pch = 19,
xlab = "n cluster",
ylab = "WSS",
main = "Elbow Plot")
#KMEANS 3 clusters
set.seed(123)
#tengo 3 kluster secondo elbow plot.. applico
kmeans_result <- kmeans(pca_df[, 1:2], centers = 3, nstart = 25, iter.max = 100)
pca_df$Cluster <- as.factor(kmeans_result$cluster)
#attenzione: metto i cluster in formato numerico (serve dopo per silhouette)
cluster_kmeans <- as.numeric(pca_df$Cluster)
#grafico 2D
library(ggplot2)
ggplot(pca_df, aes(x = PC1, y= PC2, color = Cluster)) +
geom_point(alpha = 0.6) +
theme_minimal() +
labs(title = "Cluster K-means (k = 3) sulla PCA",
x = paste0("PC1(", pca_var_perc[1], "%)"),
y =paste0("PC2 (", pca_var_perc[2],"%)"),
color ="Cluster")
##3D plot per aiutarci nella comprensione e divisione visiva
#grafico imn 3D con plotly
plot_ly(pca_df, x = ~PC1, y = ~PC2,z = ~PC3,
color = ~Cluster, colors = c("tomato", "steelblue", "darkgreen"),
type ="scatter3d", mode = "markers",marker=list(size=1)) %>%
layout(title = "K-means clustering in 3D (PC1-PC2-PC3)",
scene = list(
xaxis = list(title = paste0("PC1 (", pca_var_perc[1], "%)")),
yaxis = list(title = paste0("PC2 (", pca_var_perc[2], "%)")),
zaxis = list(title = paste0("PC3 (", pca_var_perc[3], "%)"))
))#noto un gruppetto di outliers.. provvedo dopo ad indagare a che variabili sono dovuti##analizzo le caratteristiche medie per ogni cluster! per comprendere le differenze effettive
#unisco i cluster al dataframe originale
df_clustered <- cbind(df, Cluster = pca_df$Cluster)
# Calcolo statistiche medie per ogni cluster.. ANALISI INDISPENSABILE per capire le caratteristiche principali di 3 tipi di omicidio!!
df_clustered %>%
group_by(Cluster) %>%
summarise(
Count = n(),
Età_media_vittima = round(mean(Victim.Age), 1),
Età_media_colpevole = round(mean(Perpetrator.Age), 1),
Percent_donne_vittime = round(mean(Victim.Sex == 1) * 100, 1),
Percent_donne_colpevoli = round(mean(Perpetrator.Sex == 1) * 100, 1),
Percent_arma_fuoco = round(mean(Weapon == 1) * 100, 1),
Percent_rel_non_stretta = round(mean(Rel_NotClose == 1) * 100, 1),
Percent_same_race = round(mean(Same_Race == 1) * 100, 1)
)## # A tibble: 3 × 9
## Cluster Count Età_media_vittima Età_media_colpevole Percent_donne_vittime
## <fct> <int> <dbl> <dbl> <dbl>
## 1 1 56377 30.8 27.2 6.2
## 2 2 18560 21.5 27.6 45.6
## 3 3 27787 50.3 45.9 65.5
## # ℹ 4 more variables: Percent_donne_colpevoli <dbl>, Percent_arma_fuoco <dbl>,
## # Percent_rel_non_stretta <dbl>, Percent_same_race <dbl>##Silhouette analisi
set.seed(123)
sample_idx <- sample(nrow(pca_df), 10000)
pca_small <- pca_df[sample_idx, 1:2]
cluster_small <- as.numeric(pca_df$Cluster[sample_idx])
#istanza e silhouette
dist_small <- dist(pca_small)
sil <- silhouette(cluster_small, dist_small)
fviz_silhouette(sil) #grafico## cluster size ave.sil.width
## 1 1 5421 0.55
## 2 2 1838 0.35
## 3 3 2741 0.38
##extra: provo a fare una cosa interessante individo gli outlier rispetto ai cluster trovati, ovvero i punti con silhouette negativa. Questo per comprendere la parte di dati che si distribuisce più distante dai centroidi, non adattandosi bene ai klusters
#subset usato per la silhouette
set.seed(123)
sample_idx <- sample(nrow(pca_df), 10000)
pca_small <- pca_df[sample_idx, 1:2]
cluster_small <- as.numeric(pca_df$Cluster[sample_idx])
sil_df <- as.data.frame(sil) #lo trasformo in df
#ATTENZIONE.. prendo solo le distanze negative, per risalire alle variabili iniziali che danno "problemi"
outliers <- sil_df %>% filter(sil_width < 0)
#recupero i dati originali collegati a tali valori
outlier_idx <- as.integer(rownames(outliers))
dati_outlier <- df_clustered[sample_idx[outlier_idx], ]
dati_outlier## Crime.Type Victim.Sex Victim.Age Perpetrator.Sex Perpetrator.Age Weapon
## 51663 1 0 27 0 18 1
## 57870 1 0 21 0 22 1
## 2986 1 0 22 1 25 1
## 29925 1 0 56 0 24 1
## 95246 1 0 16 0 16 1
## 68293 1 0 43 0 20 0
## 62555 1 0 23 0 26 0
## 45404 1 1 44 0 44 1
## 65161 1 0 40 0 56 1
## 46435 1 0 46 0 28 1
## 9642 1 0 52 0 26 0
## 59134 1 1 23 0 30 1
## 52132 1 0 24 0 22 1
## 96849 0 0 2 0 77 1
## 14183 1 0 19 0 20 0
## 15180 1 0 22 0 30 1
## 27168 1 0 37 0 23 1
## 89709 1 1 31 0 38 1
## 9097 1 0 53 1 51 0
## 30538 1 0 35 0 23 1
## 56219 1 1 50 0 17 1
## 94517 1 0 40 0 25 1
## 7989 1 1 44 0 14 0
## 13536 1 1 33 1 37 0
## 90077 1 0 55 0 44 1
## 6216 1 0 24 0 22 1
## 83519 1 0 29 0 24 1
## 29394 1 1 1 1 20 0
## 53241 1 0 31 0 21 0
## 28825 1 0 22 0 39 0
## 41 1 0 24 0 45 1
## 14426 1 0 22 0 24 1
## 72820 1 1 75 0 91 1
## 51656 1 0 22 0 25 1
## 94038 1 0 21 0 55 0
## 58527 1 0 26 0 27 0
## 77009 1 0 29 0 25 1
## 43042 1 0 41 1 48 1
## 77837 1 0 21 0 24 1
## 6134 1 1 5 0 28 1
## 33523 1 1 31 0 48 0
## 21812 1 0 22 0 21 1
## 39895 1 1 34 0 35 0
## 9640 1 0 0 0 28 0
## 85278 1 0 32 0 33 1
## 9326 1 1 22 0 28 1
## 26510 1 0 20 0 21 1
## 20960 1 0 33 0 35 1
## 14403 1 0 26 0 23 1
## 64502 1 0 29 0 36 1
## 71503 1 1 38 0 60 1
## 45221 1 1 57 0 61 1
## 94335 1 0 28 0 50 0
## 92372 1 1 19 0 26 1
## 77585 1 0 33 0 33 1
## 80686 1 0 17 0 18 0
## 70563 1 1 53 0 47 0
## 32606 1 0 45 0 62 1
## 16152 1 0 20 0 21 1
## 25559 1 0 42 0 28 1
## 14215 1 1 5 1 33 0
## 14287 1 0 75 1 67 0
## 23194 1 0 49 0 23 1
## 90094 1 0 28 0 19 1
## 34976 1 0 16 0 13 1
## 14491 1 0 31 0 39 1
## 82949 1 0 30 0 19 1
## 77584 1 0 3 0 24 0
## 40503 1 1 49 0 57 1
## 34724 1 0 44 0 25 1
## 86013 1 0 34 0 25 1
## 17369 1 0 75 0 18 1
## 31542 1 1 54 0 58 0
## 102537 1 0 34 0 48 1
## 59106 1 0 77 0 27 1
## 86605 1 0 26 0 19 1
## 40632 1 0 50 0 19 1
## 96111 1 0 22 0 21 1
## 43204 1 1 21 0 28 1
## 37544 1 1 52 0 34 0
## 99289 1 0 1 1 19 0
## 84427 1 0 27 0 64 0
## 76820 1 0 20 0 19 0
## 82115 1 0 51 1 39 0
## 44196 1 0 20 0 22 1
## 92337 1 1 14 0 19 0
## 44983 1 0 17 0 18 0
## 91438 1 0 32 1 52 1
## 36717 1 0 85 0 35 0
## 28078 1 0 41 1 16 0
## 69369 1 0 65 0 33 0
## 91564 1 0 45 0 52 1
## 43406 1 0 35 0 34 1
## 41488 1 1 35 0 41 0
## 47485 1 0 20 0 30 1
## 63528 1 1 78 0 50 0
## 14536 1 0 19 0 19 1
## 83069 1 0 36 0 46 1
## 51465 1 1 19 0 22 1
## 26503 1 1 0 0 26 0
## 88299 1 0 29 0 33 0
## 32953 1 1 29 0 32 0
## 413 1 0 39 0 39 0
## 10762 1 1 2 0 23 0
## 48182 1 1 28 0 25 1
## 30571 1 1 79 0 59 0
## 42521 1 0 63 0 16 1
## 74522 1 1 46 1 33 0
## 14745 1 1 30 0 16 1
## 25946 1 0 60 0 17 1
## 80340 1 0 17 0 30 0
## 43928 1 0 36 0 41 0
## 6601 1 0 23 0 19 1
## 57701 1 0 44 0 45 1
## 53518 1 1 33 0 28 0
## 72326 1 0 35 0 17 1
## 52353 1 0 28 0 55 1
## 66154 1 0 35 0 26 0
## 47802 1 0 37 0 17 1
## 31517 1 1 12 0 36 0
## 66075 1 0 26 1 24 0
## 32263 1 0 2 0 35 0
## 95989 1 0 16 0 14 0
## 69161 1 0 45 0 20 1
## 81118 1 0 20 0 48 1
## 56157 1 0 42 0 25 1
## Rel_NotClose Same_Race Cluster
## 51663 1 0 1
## 57870 1 1 1
## 2986 0 1 2
## 29925 1 1 1
## 95246 0 1 1
## 68293 1 1 1
## 62555 1 1 1
## 45404 0 1 3
## 65161 1 0 1
## 46435 0 1 1
## 9642 1 1 1
## 59134 0 1 3
## 52132 1 0 1
## 96849 1 1 2
## 14183 1 1 1
## 15180 1 0 1
## 27168 1 1 1
## 89709 1 1 1
## 9097 0 1 3
## 30538 0 1 1
## 56219 1 1 1
## 94517 1 1 1
## 7989 1 0 1
## 13536 0 1 2
## 90077 1 0 1
## 6216 1 1 1
## 83519 1 0 1
## 29394 0 1 2
## 53241 1 0 1
## 28825 0 1 2
## 41 1 1 1
## 14426 1 1 1
## 72820 0 1 3
## 51656 1 1 1
## 94038 1 1 1
## 58527 1 1 1
## 77009 1 1 1
## 43042 0 1 3
## 77837 1 1 1
## 6134 0 1 2
## 33523 0 1 3
## 21812 1 0 1
## 39895 0 1 3
## 9640 0 1 2
## 85278 0 1 1
## 9326 0 1 2
## 26510 1 1 1
## 20960 1 1 1
## 14403 1 1 1
## 64502 1 0 1
## 71503 1 1 3
## 45221 0 1 3
## 94335 0 1 3
## 92372 1 0 1
## 77585 1 1 1
## 80686 0 0 1
## 70563 0 1 3
## 32606 1 1 3
## 16152 1 1 1
## 25559 1 1 1
## 14215 0 1 2
## 14287 0 1 3
## 23194 1 0 1
## 90094 1 1 1
## 34976 0 1 1
## 14491 1 1 1
## 82949 1 1 1
## 77584 0 1 2
## 40503 0 1 3
## 34724 1 1 1
## 86013 1 1 1
## 17369 1 1 1
## 31542 1 0 3
## 102537 1 1 1
## 59106 1 0 1
## 86605 1 1 1
## 40632 1 0 1
## 96111 1 1 1
## 43204 0 1 2
## 37544 1 1 3
## 99289 0 1 2
## 84427 0 1 3
## 76820 1 1 1
## 82115 0 1 2
## 44196 1 1 1
## 92337 1 1 2
## 44983 1 1 1
## 91438 1 0 1
## 36717 1 1 3
## 28078 1 1 2
## 69369 1 1 1
## 91564 1 1 1
## 43406 0 1 1
## 41488 0 1 3
## 47485 1 1 1
## 63528 0 1 3
## 14536 1 1 1
## 83069 1 1 1
## 51465 1 1 1
## 26503 0 1 2
## 88299 1 1 1
## 32953 1 0 1
## 413 0 1 3
## 10762 1 1 2
## 48182 0 1 2
## 30571 0 1 3
## 42521 1 1 1
## 74522 1 1 2
## 14745 1 1 1
## 25946 1 1 1
## 80340 1 1 1
## 43928 0 1 3
## 6601 1 0 1
## 57701 1 1 1
## 53518 0 1 2
## 72326 0 1 1
## 52353 1 1 1
## 66154 0 1 2
## 47802 1 0 1
## 31517 0 1 2
## 66075 0 1 2
## 32263 0 1 2
## 95989 1 1 1
## 69161 0 1 1
## 81118 1 1 1
## 56157 1 0 1#CLUSTERING GERARCHICO tecnica alternativa al k-means
set.seed(123)
sample_idx <- sample(nrow(pca_df), 10000) #subset per alleggerire i calcoli
pca_subset<- pca_df[sample_idx, 1:2] #uso solo i primi due componenti
#calcolo distanzA euclidea tra i punti
dist_hc <-dist(pca_subset)
hc<- hclust(dist_hc, method = "ward.D2") #algoritmo gerarchico ward.D2 = cerca di minimizzare varianza interna
plot(hc, labels= FALSE, hang =-1, main = "Dendrogramma - Hierarchical Clustering")
#evidenzio a mano i cluster (k=3 come prima) e assegno i cluster trovati
rect.hclust(hc, k = 3, border= 2:4)
hc_clusters<- cutree(hc, k = 3)#confronto finale
#cluster da k-means sullo stesso sample usato per l'hierarchical
kmeans_sample <-as.numeric(pca_df$Cluster[sample_idx])
#tabella confronto
table(kmeans_sample, hc_clusters)## hc_clusters
## kmeans_sample 1 2 3
## 1 5399 22 0
## 2 46 1787 5
## 3 712 567 1462